Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d7/dial32.arc/DIAL.BAS

BASIC Source File | 1989-04-25 | 34.4 KB | 1,469 lines

'Sun  Apr 23, 1989   1:36:45 pm
'****************************************************************************
'* 04/15/89                                                         VER 3.2 *
'*                     ****  DIAL PHONE DIALER  ****                        *
'*                              Written in                                  *
'*                             QUICKBASIC 4.5                               *
'*                                                                          *
'* (c) 1989 by DAVID WESSON, PhD.  238 S. Quaker La. W.Hartford, CT 06119   *
'****************************************************************************
'
' $INCLUDE: 'dial.dec'
'
'========================== MAIN PROGRAM STARTS HERE ========================
     initialize
     readcommandline
     menuroutine
     goodbye
'======================= DECLARED SUBROUTINES START HERE ====================

SUB addnames
    pagehead "DIRECTORY BUSINESS"
    prompt "Enter Blank line or [Esc] to end input."
    startrec = numrecs
    DO
        numrecs = numrecs + 1
        d$(1) = "ADDING names and phone numbers to Directory."
        d$(2) = "Enter NAME  : " + STRING$(20, 254)
        d$(3) = "Enter NUMBER: " + STRING$(15, 254)
        d$(4) = "Use  - hyphens for pauses only."
        dialog 8, "ENTER NAMES"
        COLOR back, fore
        LOCATE 20, 33
        keyin 20
        IF in$ = "" OR in$ = esc$ THEN numrecs = numrecs - 1: EXIT DO
        name$(numrecs) = UCASE$(in$)
        IF in$ = "" OR in$ = esc$ THEN numrecs = numrecs - 1: EXIT DO
        LOCATE 21, 33
        keyin 15
        number$(numrecs) = in$
        IF in$ = "" OR in$ = esc$ THEN numrecs = numrecs - 1: EXIT DO
    LOOP UNTIL numrecs = 480
    IF numrecs = startrecs THEN EXIT SUB
    sortdatafile
    writedatafile
END SUB

SUB changedir
    pagehead "CHANGE DIRECTORY"
    IF phonelist$ = "" THEN
        prompt "Enter filename of DIRECTORY: " + STRING$(12, 254)
        COLOR fore, back
        LOCATE 25, 48
        keyin 25
        IF in$ = "" OR in$ = esc$ THEN EXIT SUB
        phonelist$ = in$
        clearall
        restart
    END IF
    datafile$ = path$ + phonelist$
    phonelist$ = ""
    checkdatafile
    viewdir
END SUB

SUB checkdatafile

Check.for.datafile:
    datafile = FREEFILE
    OPEN datafile$ FOR RANDOM AS datafile
    IF LOF(datafile) = 0 THEN
        CLOSE datafile
        KILL datafile$
        prompt "No Directory file by that name found. Hit a key or button."
        inbutton
        makenewdir
    END IF
    CLOSE datafile

Check.Top.Line:
    opendatafile
    INPUT #datafile, v
    IF v < 3.2 THEN
        CLOSE #datafile
        opendatafile
        LINE INPUT #datafile, x$
        tempfile = FREEFILE
        OPEN tempfile$ FOR OUTPUT AS tempfile
        WRITE #tempfile, version, port$, tone$, initial$, prefix$, path$, fore, back, high, freq, mouseon
        WHILE NOT EOF(datafile)
            LINE INPUT #datafile, l$
            PRINT #tempfile, l$
        WEND
        CLOSE
        KILL datafile$
        NAME tempfile$ AS datafile$
        LOCATE 15, 15: PRINT "New datafile format installed, reset port settings."
        readdatafile
        setport
    END IF
    CLOSE
    readdatafile
END SUB

SUB checkinput
    getmouse
    SELECT CASE button
        CASE 1: in$ = enter$
        CASE 2: in$ = esc$
        CASE ELSE: in$ = UCASE$(INKEY$)
    END SELECT
END SUB

SUB clearall
    pagehead ""
    COLOR fore, back
    VIEW PRINT 5 TO 24
    CLS
    VIEW PRINT
END SUB

SUB click
    IF freq <> 0 THEN SOUND freq, 1
END SUB

SUB clock
    row = CSRLIN
    col = POS(0)
    COLOR back, fore
    LOCATE 1, 68: PRINT newtime$(TIME$)
    LOCATE row, col
END SUB

SUB deletename
    pagehead "DIRECTORY BUSINESS"
    DO
        prompt "Enter FULL or PARTIAL NAME to be deleted, or [Esc] to EXIT."
        d$(2) = "Enter FULL or PARTIAL NAME: " + STRING$(20, 254)
        dialog 5, "DELETE NAME"
        LOCATE 20, 44
        keyin 20
        IF in$ = "" OR in$ = esc$ THEN EXIT DO
        name$ = UCASE$(in$)
        found = 0: x = 0
        DO UNTIL x = numrecs
            x = x + 1
            IF LEFT$(UCASE$(name$(x)), LEN(name$)) = name$ THEN
                LOCATE 20, 44: PRINT name$(x)
                found = 1
                prompt "Hit any key or left button to confirm delete, or [Esc] to ABORT."
                inbutton
            END IF
            IF in$ = esc$ THEN EXIT SUB
            name$(x) = name$(x + found)
            number$(x) = number$(x + found)
        LOOP
        numrecs = numrecs - found
        IF found = 0 THEN prompt "No listing by that name in Directory. Hit a key or button.": inbutton
   LOOP
   writedatafile
END SUB

SUB demondial
    demon = 1
    DO
        try = try + 1
        placecall
        IF call$ = "" THEN EXIT DO
    LOOP
    try = 0
    demon = 0
    call$ = ""
    dial$ = ""
END SUB

SUB dialheader
    COLOR fore, back
    LOCATE 2, 1
    PRINT SPACE$(160);
    LOCATE 3, 1
END SUB

SUB dialog (margin, head$)
    COLOR high, fore
    LOCATE 18, 10
    PRINT SPACE$(30 - (LEN(head$) / 2)); head$; SPACE$(70 - POS(0))
    COLOR back, fore
    FOR x = 1 TO 4
          LOCATE 18 + x, 9
          PRINT CHR$(176); SPACE$(1 + margin); d$(x); SPACE$(70 - POS(0))
    NEXT x
    LOCATE 23, 9: PRINT STRING$(60, 176)
    FOR x = 1 TO 4
        d$(x) = ""
    NEXT x
END SUB

SUB dirhead
      a$ = SPACE$(22): LSET a$ = datafile$
      b$ = SPACE$(15): LSET b$ = initial$
      c$ = SPACE$(15): LSET c$ = prefix$
      LOCATE 4, 1
      COLOR back, fore
      PRINT SPACE$(1); a$; dev$; port$; dev$;
      PRINT tone$; dev$; b$; dev$; "* = "; c$; SPACE$(1)
      COLOR fore, back
END SUB

FUNCTION dosvers
    t1 = &H3000: t2 = 0: t3 = 0: t4 = 0
    inregs.ax = t1: inregs.bx = t2: inregs.cx = t3: inregs.dx = t4
    CALL interrupt(&H21, inregs, outregs)
    t1 = outregs.ax: t2 = outregs.bx: t3 = outregs.cx: t4 = outregs.dx
    al = t1 - ((FIX(t1 / 256)) * 256)
    ah = FIX(t1 / 256)
    dosvers = al + (ah / 100)
END FUNCTION

SUB editname
    pagehead "DIRECTORY BUSINESS"
    DO
        found = 0
        prompt "Enter FULL or UNIQUE PARTIAL NAME, or Blank or [Esc] to EXIT."
        d$(1) = "NAME or PARTIAL NAME   : " + STRING$(20, 254)
        d$(3) = "NEW NAME or [Return]   : " + STRING$(20, 254)
        d$(4) = "NEW NUMBER or [Return] : " + STRING$(15, 254)
        dialog 6, "EDIT DIRECTORY ENTRY"
        LOCATE 19, 42
        keyin 20
        IF in$ = "" OR in$ = esc$ THEN EXIT DO
        name$ = UCASE$(in$)
        x = 0
        DO UNTIL x = numrecs
            x = x + 1
            IF LEFT$(name$(x), LEN(name$)) = name$ THEN
                LOCATE 19, 42: PRINT name$(x)
                found = x
                EXIT DO
            END IF
        LOOP
        LOCATE 21, 42
        keyin 20
        IF in$ = esc$ THEN EXIT DO
        newname$ = UCASE$(in$)
        IF newname$ <> "" THEN name$(found) = newname$
        LOCATE 22, 42
        keyin 15
        IF in$ = esc$ THEN EXIT DO
        newnumber$ = UCASE$(in$)
        IF newnumber$ <> "" THEN number$(found) = newnumber$
        IF found = 0 THEN prompt "No listing by that name found. Hit a key or button.": inbutton
    LOOP
    sortdatafile
    writedatafile
END SUB

SUB findname
    IF LEFT$(name$, 1) = "*" THEN name$ = MID$(name$, 2): add$ = prefix$
    IF VAL(LEFT$(name$, 1)) > 0 THEN
        call$ = name$
        dial$ = add$ + name$
        hyphen
        EXIT SUB
        ELSE
        FOR x = 1 TO numrecs
            IF LEFT$(name$(x), LEN(name$)) = name$ THEN
                call$ = name$(x)
                dial$ = add$ + number$(x)
            END IF
        NEXT x
    END IF
    IF call$ = "" THEN prompt "No listing for that name found. Hit a key or button.": inbutton
    hyphen
END SUB

SUB getbutton
    DO
        inbutton
        IF in$ = enter$ THEN
            SELECT CASE mrow
                CASE 2
                    mousecommand
                CASE 5 TO 24
                    mouseread
                    mousemove 2, 80
                CASE 25
                    mousepage
            END SELECT
        END IF
    LOOP UNTIL in$ <> ""
END SUB

SUB getmouse
    mouse 3, button, x, y
    mrow = INT(y / 8) + 1
    mcol = INT(x / 8) + 1
END SUB

SUB getname
    prompt "Enter * for Prefix Code, Name, Number, or [Esc] to EXIT."
    d$(1) = "Enter NAME or UNIQUE PARTIAL NAME or"
    d$(2) = "enter phone number using hyphen"
    d$(3) = "for 2 second pause. * for PREFIX CODE."
    d$(4) = "NAME: " + STRING$(20, 254)
    dialog 10, "PLACE CALL"
    LOCATE 22, 27
    keyin 20
    IF in$ = "" OR in$ = esc$ THEN EXIT SUB
    IF VAL(in$) = 0 THEN
        name$ = UCASE$(in$)
        findname
        ELSE call$ = in$
             dial$ = in$
    END IF
    LOCATE 22, 27: PRINT call$
END SUB

SUB getsubletter
    x = 0
    DO
        x = x + 1
        IF in$ = LEFT$(sel$(sel, x), 1) THEN
            subsel = x
            in$ = enter$
               EXIT DO
        END IF
    LOOP UNTIL x = totsubs
END SUB

SUB goodbye
    hidemouse
    COLOR 7, 0
    CLOSE
    CLS
    END
END SUB

SUB hangup
    dialheader
    IF port = 0 THEN EXIT SUB
    CLOSE port
    OPEN port$ FOR OUTPUT AS port
    FOR x = 1 TO 3
        PRINT #port, "ATH0"
    NEXT x
    LOCATE 2, 1
    COLOR high, back
    PRINT "Modem hung-up."
    COLOR fore, back
    CLOSE port
END SUB

SUB header
    LOCATE 1, 1
    COLOR back, fore
    PRINT SPACE$(80);
    LOCATE 1, 1
    COLOR high: PRINT " DIAL";
    COLOR back, fore: PRINT " Phone Dialer v3.2"
    LOCATE 1, 44: PRINT newdate$;
    LOCATE 1, 68: PRINT newtime$(TIME$)
    COLOR fore, back
END SUB

SUB helpscreen (page)
    clearall
    IF page = 2 THEN GOTO page2
    pagehead "HELP WITH FULL SCREEN MODE"
    PRINT ""
    PRINT ""
    PRINT "           EXECUTE COMMANDS:"
    PRINT "                Use [LeftArrow] or [RightArrow] and hit [Return]"
    PRINT "                or hit any of the highlighted initial letters"
    PRINT ""
    PRINT "           VIEW DIRECTORY:"
    PRINT "                [PgDn]     View next page"
    PRINT "                [PgUp]     View previous page"
    PRINT "                [Home]     View first page"
    PRINT "                [End]      View last page"
    PRINT ""
    PRINT "           MOUSE CONTROL:  Left Button = [Return]    Right Button = [Esc] "
    PRINT "                Move cursor to command and click. Or move cursor to name"
    PRINT "                or number, then double click left button to dial."
    PRINT "                Click on page buttons on bottom line to page directory."
    PRINT "                Hit [Esc] at any time to cancel commands or EXIT program."
    PRINT "                Turn Mouse on or off inside Settings option on top menu."
    prompt "Hit any key or button to continue."
    inbutton
    EXIT SUB
page2:
    pagehead "DIAL COMMANDS FOR DOS LINE OPERATION"
    PRINT ""
    PRINT ""
    PRINT "           name      Gets name from directory and dials its number."
    PRINT "                     Uses full name or unique first part of name."
    PRINT ""
    PRINT "           number    Dialing a number not in the Directory."
    PRINT ""
    PRINT "           @file     Activates directory file other than default DIAL.DAT."
    PRINT ""
    PRINT "           *number   Dial prefix before number."
    PRINT ""
    PRINT "           *name     Dial prefix before number that goes with name."
    PRINT ""
    PRINT "           When assigning phone numbers, insert hyphen for two second pause."
    PRINT ""
    PRINT "           NOTE: This program assumes use of the Hayes command set.";
    prompt "Hit any key or button to continue."
    inbutton
END SUB

SUB hidemouse
    mouse 2, 0, 0, 0
END SUB

SUB hyphen
    IF LEFT$(dial$, 1) = "*" THEN dial$ = prefix$ + MID$(dial$, 2)
    FOR d = 1 TO LEN(dial$)
        IF MID$(dial$, d, 1) = "-" THEN
            MID$(dial$, d, 1) = ","
        END IF
    NEXT d
END SUB

SUB inbutton
    DO
        clock
        checkinput
    LOOP UNTIL in$ <> ""
END SUB

SUB initialize
    CLS
    IF dosvers >= 3 THEN
        IF mouseinstalled = 0 THEN mouseon = 0 ELSE mouseon = 1
        ELSE mouseon = 0
    END IF
    LOCATE , , 0, 6, 7           'turns cursor off
    version = 3.2
    port$ = "COM1:"
    tone$ = "TONE"
    initial$ = "Q0 V1 X4 S0=0"
    prefix$ = ""
    path$ = ""
    fore = 7
    back = 0
    high = 15
    freq = 750
    items = 7
    menuarrays
    setnames
    datafile$ = "DIAL.DAT"
    tempfile$ = "dial.tmp"
    header
    checkdatafile
    mouseis mouseon
    logfile$ = path$ + "dial.log"
END SUB

'---------------------- INPUT ANSWER FROM KEYBOARD ----------------------------
SUB keyin (length)
     word$ = ""
     inrow = CSRLIN: incol = POS(0): ch$ = CHR$(SCREEN(inrow, incol))
     COLOR back + 16, fore: PRINT ch$; CHR$(29);
     DO
      dummy = 0
      IF LEN(word$) = 1 AND length = 1 THEN in$ = enter$ ELSE inbutton
      SELECT CASE in$
        CASE enter$
            COLOR back, fore
            IF LEN(word$) < length THEN PRINT ch$;
            in$ = word$
            EXIT DO
        CASE esc$
            in$ = esc$
            EXIT DO
        CASE bksp$                                        'bksp and blank out answer
            IF word$ <> "" THEN
                COLOR back, fore
                IF LEN(word$) <> length THEN PRINT CHR$(254);  ELSE PRINT CHR$(0);
                COLOR back + 16, fore
                PRINT CHR$(29); CHR$(29); CHR$(254); CHR$(29);
                word$ = LEFT$(word$, LEN(word$) - 1)
            END IF
        CASE ELSE
            IF LEN(word$) = length THEN
                click
                ELSE
                    LOCATE inrow, incol
                    word$ = word$ + in$
                    PRINT word$;
                    IF LEN(word$) <> length THEN
                        COLOR back + 16, fore
                        PRINT CHR$(254); CHR$(29);
                    END IF
            END IF
      END SELECT
    LOOP
END SUB

SUB logcall
    IF call$ = "" THEN EXIT SUB
    LOCATE 3, 1
    COLOR high, back
    PRINT "When phone is answered, hit L to LOG call, or any key or button to EXIT."
    COLOR fore, back
    inbutton
    IF in$ <> "L" THEN EXIT SUB
    openlogfile
    ontime$ = newtime$(TIME$)
        onhour = VAL(hour$)
        onmin = VAL(min$)
        onsec = VAL(sec$)
    d$(2) = "At end of call, hit any key or button to log time."
    d$(3) = "            Elapsed Time: 00:00"
    dialog 5, "LOG CALL"
    start = TIMER
    timeout
    prompt "Call to " + call$ + " logged in DIAL.LOG."
    PRINT #logfile, newdate$, LEFT$(call$, 12), dial$, ontime$, offtime$, tottime$
    CLOSE logfile
END SUB

SUB mainscreen
      header
      viewdir
END SUB

SUB makenewdir
    pagehead "DIRECTORY"
    d$(1) = "This utility makes a new phone directory. Enter"
    d$(2) = "a name for the new directory. If an existing"
    d$(3) = "filename is specified, that file will be DELETED."
    d$(4) = "Use DIAL.DAT only to make a new default directory."
    dialog 5, "MAKE NEW DIRECTORY"
    prompt "Enter filename: " + STRING$(12, 254)
    COLOR back, fore
    LOCATE 25, 42
    keyin 12
    IF in$ = "" OR in$ = esc$ THEN datafile$ = "DIAL.DAT": EXIT SUB
    restart
    datafile$ = in$
    IF datafile$ = "DIAL.DAT" THEN
        LOCATE 7, 1
        COLOR fore, back
        PRINT "============================================================================"
        COLOR high
        PRINT "WARNING: ";
        COLOR fore
        PRINT "If you proceed with this, existing DIAL.DAT file will be replaced."
        PRINT "                  Hit [Esc] to EXIT or any key to continue."
        PRINT "============================================================================"
        prompt "Continuing will replace existing default Directory. Hit [Esc] to EXIT."
        inbutton
        IF in$ = esc$ THEN goodbye
        ELSE datafile$ = path$ + datafile$
    END IF
    numrecs = 0
    addnames
END SUB

SUB menuarrays

'======= Define Top Slide Bar Menu
sel$(1, 0) = "Place call"
sel$(2, 0) = "Directory"
sel$(3, 0) = "Change dir"
sel$(4, 0) = "Modem hang up"
sel$(5, 0) = "Settings"
sel$(6, 0) = "Help"
sel$(7, 0) = "Exit"
'===== Define Help messages for line 3

sel$(1, 10) = "Place and log call, Demon dial call                                             "
sel$(2, 10) = "Add, edit and delete names and numbers                                          "
sel$(3, 10) = "Change directory file, make a new directory file                                "
sel$(4, 10) = "Hang up modem line                                                              "
sel$(5, 10) = "Set colors, beep, mouse, port, dial type, default path and prefix code          "
sel$(6, 10) = "Help with DOS commands and with this screen                                     "
sel$(7, 10) = "Exit from this program                                                          "

'===== Define Sub Selections For Menu Items   NOTE: each submenu item is same length

sel$(1, 1) = "Place call"
sel$(1, 2) = "Demon dial"

sel$(2, 1) = "Add names + #s"
sel$(2, 2) = "Edit name + #s"
sel$(2, 3) = "Delete name   "

sel$(3, 1) = "Change dir  "
sel$(3, 2) = "Make new dir"

sel$(4, 1) = "Hang up modem now"

sel$(5, 1) = "Port "
sel$(5, 2) = "Color"
sel$(5, 3) = "Sound"
sel$(5, 4) = "Mouse"
sel$(5, 5) = "DPath"

sel$(6, 1) = "Full Screen"
sel$(6, 2) = "DOS Command"

sel$(7, 1) = "EXIT NOW"

END SUB

SUB menufindcol
    col = 1
    FOR x = 1 TO sel - 1
        col = col + LEN(sel$(x, 0)) + 2
    NEXT x
END SUB

SUB menuhighlight
    COLOR high, fore
    LOCATE lin, col
    PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1);
    COLOR back, fore
    PRINT MID$(sel$(sel, subsel), 2); SPACE$(1);
    COLOR fore, back
    LOCATE 3, 1: PRINT sel$(sel, 10)
END SUB

SUB menuinput
    menutopline
    menutoploop                           'gets first menu command
    IF sel = 0 THEN EXIT SUB              'if escape is passed then exit
    hidemouse
DO
    menufindcol
    subwindow
    mousewindow 74, 80, 4, totsubs + 3
    DO                                    'gets second menu command
        lin = subsel + 3
        mousemove lin, 77
        subhighlight
        subbutton
        menufindcol
        menuhighlight
        getsubletter
        SELECT CASE in$               'analyzes keystrokes
            CASE esc$
                showmouse
                EXIT SUB
            CASE enter$
                showmouse
                sel = (sel * 10) + subsel
                EXIT SUB
            CASE lft$
                subsel = 1
                sel = sel - 1
                IF sel < 1 THEN sel = items
                menufindcol
                EXIT DO
            CASE rght$
                subsel = 1
                sel = sel + 1
                IF sel > items THEN sel = 1
                menufindcol
                EXIT DO
            CASE up$
                subsel = subsel - 1
                IF subsel < 1 THEN subsel = 1
            CASE down$
                subsel = subsel + 1
                IF subsel > totsubs THEN subsel = totsubs
            CASE end$
                subsel = totsubs
            CASE home$
                subsel = 1
        END SELECT
    LOOP
    viewdir                                'refreshes screen, erase window
LOOP
END SUB

SUB menuletter
    FOR x = 1 TO items
        IF in$ = LEFT$(sel$(x, 0), 1) THEN
            sel = x
            in$ = enter$
        END IF
    NEXT x
    menufindcol
END SUB

SUB menuroutine
    DO
        mainscreen
        menuinput
        mousewindow 1, 80, 2, 25
        IF sel <> 0 AND sel <> 61 THEN viewdir
        SELECT CASE sel
            CASE 0:  EXIT DO 'escape key
            CASE 11: placecall
            CASE 12: demondial
            CASE 21: addnames
            CASE 22: editname
            CASE 23: deletename
            CASE 31: changedir
            CASE 32: makenewdir
            CASE 41: hangup
            CASE 51: setport
            CASE 52: setcolor
            CASE 53: setsound
            CASE 54: setmouse
            CASE 55: setdpath
            CASE 61: helpscreen 1
            CASE 62: helpscreen 2
            CASE 71: EXIT DO
            CASE ELSE: click
        END SELECT
    LOOP
END SUB

SUB menutopline
    col = 1
    sel = 1
    subsel = 0
    lin = 2
    FOR x = 1 TO items                    'prints top menu line
        sel = x
        menuunhighlight
        col = col + LEN(sel$(sel, 0)) + 2
    NEXT
    col = 1
    sel = 1
    menuhighlight                         'highlights first menu item
    showmouse
END SUB

SUB menutoploop
    DO
        getbutton
        menufindcol
        menuunhighlight
        menuletter
        SELECT CASE in$
            CASE esc$
                sel = 0
                EXIT DO
            CASE enter$, down$
                EXIT DO
            CASE rght$
                col = col + LEN(sel$(sel, 0)) + 2
                sel = sel + 1
                IF sel > items THEN sel = 1: col = 1
            CASE lft$
                col = col - LEN(sel$(sel - 1, 0)) - 2
                sel = sel - 1
                IF sel < 1 THEN sel = items: menufindcol
            CASE pgup$
                IF dirpage = 0 THEN
                    click
                    ELSE dirpage = dirpage - 40
                         IF dirpage < 0 THEN dirpage = 0
                         viewdir
                END IF
            CASE pgdn$
                IF dirpage = 440 OR dirpage >= numrecs - 40 THEN
                    click
                    ELSE dirpage = dirpage + 40
                        viewdir
                END IF
            CASE home$
                IF dirpage > 0 THEN
                    dirpage = 0
                    viewdir
                    ELSE click
                END IF
            CASE end$
                IF dirpage = 440 OR dirpage >= numrecs - 40 THEN
                    click
                    ELSE dirpage = numrecs - 40
                         viewdir
                END IF
            CASE ELSE
                click
        END SELECT
        menuhighlight
    LOOP
END SUB

SUB menuunhighlight
    LOCATE lin, col
    COLOR high, back
    PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1);
    COLOR fore, back
    PRINT MID$(sel$(sel, subsel), 2); SPACE$(1);
END SUB

SUB mouse (m1, m2, m3, m4)
    IF mouseon = 0 THEN EXIT SUB
    inregs.ax = m1
    inregs.bx = m2
    inregs.cx = m3
    inregs.dx = m4
    CALL interrupt(51, inregs, outregs)
    m1 = outregs.ax
    m2 = outregs.bx
    m3 = outregs.cx
    m4 = outregs.dx
END SUB

SUB mousecommand
    SELECT CASE mcol
        CASE 1 TO 12: in$ = "P"
        CASE 13 TO 23: in$ = "D"
        CASE 24 TO 35: in$ = "C"
        CASE 36 TO 50: in$ = "M"
        CASE 51 TO 60: in$ = "S"
        CASE 61 TO 67: in$ = "H"
        CASE 68 TO 73: in$ = "E"
        CASE ELSE: click
    END SELECT
END SUB

FUNCTION mouseinstalled
    m = 0                      ' reset function
    mouse m, n, 0, 0           ' returns M = 0 if no mouse installed
    mouseinstalled = m
END FUNCTION

SUB mouseis (mouseon)
    IF mouseon = 0 THEN m = 2 ELSE m = 1
    mouse m, 1, 0, 0
    mousewindow 1, 80, 2, 25
    mousemove 2, 80
END SUB

FUNCTION mousemotion
    IF mouseon = 0 THEN EXIT FUNCTION
    getmouse
    SELECT CASE mrow
        CASE IS > lin: m = 1
        CASE IS < lin: m = -1
        CASE ELSE: m = 0
    END SELECT
    SELECT CASE mcol
        CASE IS < 75: m = -2
        CASE IS > 79: m = 2
    END SELECT
    mousemotion = m
END FUNCTION

SUB mousemove (mrow, mcol)
    y = (mrow - 1) * 8: x = (mcol - 1) * 8
    mouse 4, button, x, y
END SUB

SUB mousepage
    SELECT CASE mcol
        CASE 2 TO 12
            in$ = "H"
        CASE 23 TO 28
            in$ = home$
        CASE 31 TO 35
            in$ = end$
        CASE 38 TO 43
            in$ = pgup$
        CASE 45 TO 51
            in$ = pgdn$
        CASE 67 TO 76
            in$ = esc$
        CASE ELSE
            click
    END SELECT
END SUB

SUB mouseread
    IF mcol > 40 THEN mcol = 41 ELSE mcol = 1
    entry$ = ""
    FOR x = mcol TO mcol + 36
        entry$ = entry$ + CHR$(SCREEN(mrow, x))
    NEXT x
    LOCATE mrow, mcol
    COLOR back, fore
    PRINT entry$;
    call$ = LTRIM$(RTRIM$(LEFT$(entry$, 20)))
    dial$ = LTRIM$(RTRIM$(MID$(entry$, 22, 15)))
    hyphen
    in$ = "P"
END SUB

SUB mousewindow (left, right, top, bottom)
    l = (left - 1) * 8: IF l < 0 THEN l = 0
    r = (right - 1) * 8: IF r > 632 THEN r = 632
    t = (top - 1) * 8: IF t < 0 THEN t = 0
    b = (bottom - 1) * 8: IF b > 192 THEN b = 192
    mouse 7, 0, l, r
    mouse 8, 0, t, b
END SUB

FUNCTION newdate$
    day$(0) = "Sunday"
    day$(1) = "Monday"
    day$(2) = "Tuesday"
    day$(3) = "Wednesday"
    day$(4) = "Thursday"
    day$(5) = "Friday"
    day$(6) = "Saturday"
    month$(1) = "Jan"
    month$(2) = "Feb"
    month$(3) = "Mar"
    month$(4) = "Apr"
    month$(5) = "May"
    month$(6) = "Jun"
    month$(7) = "Jul"
    month$(8) = "Aug"
    month$(9) = "Sep"
    month$(10) = "Oct"
    month$(11) = "Nov"
    month$(12) = "Dec"
    t1 = &H2A00: t2 = 0: t3 = 0: t4 = 0
    inregs.ax = t1: inregs.bx = t2: inregs.cx = t3: inregs.dx = t4
    CALL interrupt(&H21, inregs, outregs)
    t1 = outregs.ax: t2 = outregs.bx: t3 = outregs.cx: t4 = outregs.dx
    day = t1 - ((FIX(t1 / 256)) * 256)
    day$ = day$(day)
    year = t3
    year$ = LTRIM$(RTRIM$(STR$(year)))
    month = FIX(t4 / 256)
    month$ = month$(month)
    date = t4 - (month * 256)
    newdate$ = day$ + SPACE$(2) + month$ + STR$(date) + "," + STR$(year)
END FUNCTION

FUNCTION newtime$ (oldtime$)
     hour$ = LEFT$(oldtime$, 2)
     min$ = MID$(oldtime$, 4, 2)
     sec$ = RIGHT$(oldtime$, 2)
     hour = VAL(hour$)
          IF hour < 12 THEN ampm$ = "am" ELSE ampm$ = "pm"
          IF hour > 12 THEN hour = hour - 12
     hour$ = STR$(hour)
     newtime$ = hour$ + ":" + min$ + ":" + sec$ + " " + ampm$
END FUNCTION

SUB opendatafile
    datafile = FREEFILE
    OPEN datafile$ FOR INPUT AS datafile
END SUB

SUB openlogfile
    logfile = FREEFILE
    OPEN logfile$ FOR APPEND AS logfile
END SUB

SUB openport
    port = FREEFILE
    OPEN port$ FOR RANDOM AS port
END SUB

SUB pagehead (page$)
    LOCATE 4, 1
    COLOR back, fore
    PRINT STRING$(80, 32);
    LOCATE 4, 41 - (LEN(page$) / 2)
    COLOR high, fore
    PRINT page$;
    COLOR fore, back
END SUB

SUB placecall
    pagehead "PLACE CALL"
    IF call$ = "" THEN viewdir: getname
    IF call$ = "" THEN EXIT SUB
    mainscreen
    dialheader
    LOCATE 2, 1
    COLOR high, back
    IF demon = 1 THEN
        PRINT "DEMON-DIALING your call to "; call$; ", "; dial$; ".  TRY"; try
        PRINT "Hit any key or button to exit DEMON DIAL when connected."
    END IF
    IF demon = 0 THEN
        IF call$ = dial$ THEN
            PRINT "Your call to "; call$; " is dialing."
            ELSE PRINT "Your call to "; call$; ", "; dial$; " is dialing."
        END IF
        PRINT "Wait for RING signal, then hit any key or button to HANG UP modem."
    END IF
    checkinput
    IF in$ <> "" THEN EXIT SUB
    openport
    t$ = LEFT$(tone$, 1)
    PRINT #port, "AT " + initial$ + " D" + t$ + dial$
    DO
        clock
        checkinput
        IF in$ <> "" THEN hangup: call$ = "": EXIT SUB
        income = LOC(port)
        IF income <> 0 THEN modem$ = INPUT$(1, #port)
        SELECT CASE modem$
            CASE "B"
                hangup
                IF demon = 1 THEN EXIT SUB
                d$(1) = "Hit [SpaceBar] or Left Button to redial once,"
                d$(2) = " or [D] to demon-dial call until it connects,"
                d$(3) = " or any other key or Right Button to exit."
                dialog 5, "BUSY SIGNAL"
                prompt ""
                inbutton
                SELECT CASE in$
                    CASE CHR$(32), enter$
                        placecall
                    CASE "D"
                        demondial
                        EXIT DO
                    CASE ELSE
                        EXIT SUB
                END SELECT
            CASE "E"
                dialheader
                LOCATE 2, 1
                PRINT "ERROR: Something wrong trying to dial out. Hit a key or button."
                inbutton
                EXIT SUB
            CASE "R"
                EXIT DO
            CASE ELSE
                dummy = 0
        END SELECT
    LOOP
    ring
    hangup
    logcall
    add$ = ""
    call$ = ""
END SUB

SUB prompt (msg$)
    LOCATE 25, 1
    COLOR back, high
    PRINT SPACE$(80);
    t = INT((80 - LEN(msg$)) / 2)
    LOCATE 25, t: PRINT msg$;
    COLOR fore, back
END SUB

SUB qsort (srtn(), mid)
     DIM newname$(numrecs), newnumber$(numrecs), newsrtn(numrecs)
     y = 0: z = 0
FOR x = 1 TO numrecs
     IF srtn(x) > mid THEN
      newsrtn(numrecs - y) = srtn(x)
      newname$(numrecs - y) = name$(x)
      newnumber$(numrecs - y) = number$(x)
      y = y + 1
      ELSE newsrtn(z + 1) = srtn(x)
           newname$(z + 1) = name$(x)
           newnumber$(z + 1) = number$(x)
           z = z + 1
     END IF
NEXT x
FOR t = 1 TO numrecs
    name$(t) = newname$(t)
    number$(t) = newnumber$(t)
    srtn(t) = newsrtn(t)
NEXT t
ERASE newname$, newnumber$, newsrtn
     num$ = SPACE$(4)
     LSET num$ = STR$(numrecs)
     prompt "Total Names:" + num$ + SPACE$(10) + "Sorting #:"
     COLOR back, fore
     FOR x = 1 TO y
           FOR w = 1 TO z - x
            IF srtn(x) > srtn(x + w) THEN
                SWAP srtn(x), srtn(x + w)
                SWAP name$(x), name$(x + w)
                SWAP number$(x), number$(x + w)
            END IF
           NEXT w
     LOCATE 25, 58: PRINT x;
     NEXT x
     FOR x = y - 1 TO numrecs
           FOR y = 1 TO numrecs - x
            IF srtn(x) > srtn(x + y) THEN
                SWAP srtn(x + y), srtn(x)
                SWAP name$(x + y), name$(x)
                SWAP number$(x + y), number$(x)
            END IF
           NEXT y
     LOCATE 25, 58: PRINT x;
     NEXT x
     COLOR fore, back
END SUB

SUB readcommandline
    inline$ = UCASE$(COMMAND$)
    IF inline$ = "MAKE" THEN
        makenewdir
        inline$ = ""
    END IF
    IF inline$ = "" THEN EXIT SUB
rerun:
    mark$ = LEFT$(inline$, 1)
    SELECT CASE mark$
        CASE "@"
            phonelist$ = MID$(inline$, 2)
            restart
            changedir
            EXIT SUB
        CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
            call$ = add$ + inline$
            dial$ = add$ + inline$
        CASE ELSE
            name$ = inline$
            findname
    END SELECT
    hyphen
    placecall
    goodbye
END SUB

SUB readdatafile
    opendatafile
    numrecs = 0
    INPUT #datafile, version, port$, tone$, initial$, prefix$, path$, fore, back, high, freq, mouseon
    WHILE NOT EOF(datafile)
        numrecs = numrecs + 1
        INPUT #datafile, name$(numrecs), number$(numrecs)
    WEND
    CLOSE datafile
END SUB

SUB restart
    FOR x = 1 TO numrecs
        name$(x) = ""
        number$(x) = ""
    NEXT x
END SUB

SUB ring
    DO
        LOCATE 3, 1
        COLOR high, back
        PRINT "Pick up the receiver, THEN hit any key or button to hang up modem."
        FOR x = 1 TO 5
            SOUND 850, .85
            SOUND 650, .85
        NEXT x
        checkinput
        IF in$ <> "" THEN EXIT DO
        time1 = TIMER
        DO
            time2 = TIMER
            LOCATE 3, 1
            COLOR fore, back
            PRINT "Pick up the receiver, THEN hit any key or button to hang up modem."
            checkinput
            IF in$ <> "" THEN EXIT SUB
        LOOP UNTIL time2 = time1 + 4
    LOOP
    COLOR fore, back
END SUB

SUB setcolor
    prompt "Hit [Return] to reset entry to original setting."
    d$(1) = "   Enter number for each color selection."
    d$(3) = " 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15"
    d$(4) = "   FOREGROUND: " + STRING$(2, 254) + "   BACKGROUND: " + STRING$(2, 254) + "   HIGHLIGHT: " + STRING$(2, 254)
    dialog 2, "SET COLORS"
    LOCATE 20, 13
    FOR x = 0 TO 9
        COLOR x, 0: PRINT STRING$(3, 254);
    NEXT x
    FOR x = 10 TO 15
        COLOR x, 0: PRINT STRING$(4, 254);
    NEXT x
    COLOR back, fore
    LOCATE 22, 28
    keyin 2
    fore = VAL(in$)
    IF fore = 0 THEN fore = 7
    LOCATE 22, 45
    keyin 2
    back = VAL(in$)
    IF back = fore THEN back = 0
    LOCATE 22, 61
    keyin 2
    high = VAL(in$)
    IF high = back THEN high = 15
    writedatafile
    mainscreen
END SUB

SUB setdpath
    pagehead "SETTINGS"
    d$(1) = "This setting option permits you to specify"
    d$(2) = "the drive or suddirectory (path) for all files"
    d$(3) = "that the program makes except DIAL DAT. Use the"
    d$(4) = "full, exact pathname. Ex:  A:  or  C:\utilities  "
    dialog 5, "SET DEFAULT PATH"
    prompt "Enter full path: " + STRING$(18, 254)
    COLOR back, fore
    LOCATE 25, 39
    keyin 18
    IF in$ = "" OR in$ = esc$ THEN EXIT SUB
    path$ = in$
    IF LEN(in$) = 1 THEN
        path$ = path$ + ":"
        ELSEIF RIGHT$(path$, 1) <> ":" AND RIGHT$(path$, 1) <> "\" THEN
               path$ = path$ + "\"
    END IF
    writedatafile
END SUB

SUB setmouse
    d$(1) = "Mouse driver must be loaded and active before program"
    d$(2) = "is loaded. Do not turn mouse on otherwise. In DOS 2.x"
    d$(3) = "the program will hang if no mouse is present."
    d$(4) = "Hit [Return] to turn Mouse on, [Esc] to turn Mouse off."
    dialog 2, "SET MOUSE"
    prompt "Hit [Return] to turn Mouse ON, [Esc] to turn Mouse OFF."
askm:
    inbutton
    SELECT CASE in$
        CASE enter$
            mouseis 1
            mouseon = 1
        CASE esc$
            mouseis 0
            mouseon = 0
        CASE ELSE
            GOTO askm
    END SELECT
    writedatafile
END SUB

SUB setnames
      dev$ = CHR$(32) + CHR$(179) + CHR$(32)
      esc$ = CHR$(27)
      bksp$ = CHR$(8)
      enter$ = CHR$(13)
      up$ = CHR$(0) + CHR$(72)
      pgup$ = CHR$(0) + CHR$(73)
      pgdn$ = CHR$(0) + CHR$(81)
      home$ = CHR$(0) + CHR$(71)
      end$ = CHR$(0) + CHR$(79)
      lft$ = CHR$(0) + CHR$(75)
      rght$ = CHR$(0) + CHR$(77)
      down$ = CHR$(0) + CHR$(80)
      quote$ = CHR$(34)
      comma$ = CHR$(44)
END SUB

SUB setport
    pagehead "LINE SETTINGS"
    d$(1) = "PORT NUMBER ( if in doubt, type 1 )  : " + port$
    d$(2) = "DIALTONE TYPE ( T = Tone, P = Pulse ): " + tone$
    d$(3) = "MODEM INITIALIZATION CODES (see docs): " + STRING$(14, 254)
    d$(4) = "PREFIX CODE ( dials before a number) : " + STRING$(14, 254)
    dialog 5, "SETTINGS"
    prompt "Hit [Return] to keep settings the same."
    COLOR back, fore
    LOCATE 21, 55: PRINT initial$
    LOCATE 22, 55: PRINT prefix$
    LOCATE 19, 58
    keyin 1
    IF in$ = esc$ THEN EXIT SUB
    IF in$ = "" THEN in$ = MID$(port$, 4, 1)
    IF VAL(in$) < 0 OR VAL(in$) > 6 THEN goodbye
    port$ = "COM" + in$ + ":"
asktype:
    LOCATE 20, 55
    keyin 1
    SELECT CASE in$
        CASE "T"
            tone$ = "TONE"
        CASE "P"
            tone$ = "PULSE"
        CASE ""
            tone$ = tone$
        CASE esc$
            EXIT SUB
        CASE ELSE
            GOTO asktype
    END SELECT
    LOCATE 20, 55
    PRINT tone$ + SPACE$(1)
    LOCATE 21, 55
    keyin 14
    SELECT CASE in$
        CASE "": initial$ = initial$
        CASE esc$: EXIT SUB
        CASE ELSE: initial$ = in$
    END SELECT
    LOCATE 22, 55
    keyin 14
    SELECT CASE in$
        CASE "": prefix$ = prefix$
        CASE esc$: EXIT SUB
        CASE ELSE: prefix$ = in$
    END SELECT
    writedatafile
END SUB

SUB setsound
    prompt "Enter NUMBER for desired sound frequency of beep."
    d$(1) = "Select a sound frequency for the beep."
    d$(2) = "HIGH         MEDIUM          LOW         OFF"
    d$(3) = " 1              2             3           4"
    d$(4) = "NEW FREQUENCY: " + CHR$(254)
    dialog 5, "SET SOUND"
    LOCATE 22, 31
    COLOR back, fore
getfreq:
    inbutton
    SELECT CASE VAL(in$)
        CASE 1
            freq = 3000
        CASE 2
            freq = 750
        CASE 3
            freq = 150
        CASE 4
            freq = 0
        CASE ELSE
            GOTO getfreq
    END SELECT
    PRINT in$
    click
    writedatafile
    COLOR , fore, back
END SUB

SUB showlist
    REDIM name$(481), number$(481)
    readdatafile
    clearall
    viewdir
END SUB

SUB showmouse
    mouse 1, 0, 0, 0
END SUB

SUB sortdatafile
     prompt "Preparing to sort Directory."
     x = 1
     FOR x = 1 TO numrecs
      srtn(x) = 0
      FOR z = 1 TO 5
           letter$ = MID$(name$(x), z, 1)
           IF letter$ = "" OR letter$ < CHR$(65) OR letter$ > CHR$(90) THEN
            srtn(x) = srtn(x) * 100
            ELSE srtn(x) = (srtn(x) * 100) + (ASC(letter$) - 64)
           END IF
      NEXT z
     stotal = stotal + srtn(x)
     NEXT x
     IF numrecs = 0 THEN EXIT SUB
     mid = stotal / numrecs
     qsort srtn(), mid
END SUB

SUB subbutton
    DO
        SELECT CASE mousemotion
            CASE 1: in$ = down$
            CASE -1: in$ = up$
            CASE 2: in$ = rght$
            CASE -2: in$ = lft$
            CASE ELSE: checkinput
        END SELECT
    LOOP UNTIL in$ <> ""
    IF sel = 1 AND button = 1 THEN inbutton
END SUB

SUB subhighlight
    COLOR high, back
    LOCATE lin, col
    PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1); MID$(sel$(sel, subsel), 2); SPACE$(1);
END SUB

SUB subline
    COLOR high, fore
    LOCATE lin, col
    PRINT SPACE$(1); LEFT$(sel$(sel, subsel), 1);
    COLOR back, fore
    PRINT MID$(sel$(sel, subsel), 2); SPACE$(1);
    COLOR fore, back
    PRINT CHR$(176);
    LOCATE 3, 1: PRINT sel$(sel, 10)
END SUB

SUB subwindow
    subsel = 1
    DO UNTIL sel$(sel, subsel) = ""       'pulls down menu window
        lin = subsel + 3
        subline
        subsel = subsel + 1
    LOOP
    LOCATE lin + 1, col + 1
    PRINT STRING$(LEN(sel$(sel, 1)) + 2, 176)'prints bottom window shadow
    totsubs = subsel - 1
    subsel = 1
END SUB

SUB timeout
     DO
      checkinput
      DO UNTIL sec >= start + 1
           sec = TIMER
      LOOP
      start = start + 1
      d1 = d1 + 1
      IF d1 = 10 THEN
           d2 = d2 + 1
           d1 = 0
      END IF
      IF d2 = 6 THEN
           d3 = d3 + 1
           d2 = 0
      END IF
      IF d3 = 10 THEN
           d4 = d4 + 1
           d3 = 0
      END IF
      IF d4 = 10 THEN d4 = 0
      d1$ = LTRIM$(STR$(d1)): d2$ = LTRIM$(STR$(d2))
      d3$ = LTRIM$(STR$(d3)): d4$ = LTRIM$(STR$(d4)):
      tottime$ = d4$ + d3$ + ":" + d2$ + d1$
      LOCATE 21, 42: PRINT tottime$;
     LOOP UNTIL in$ <> ""
     offtime$ = newtime$(TIME$)
END SUB

SUB viewdir
      dirhead
      y = 1: w = 1
      FOR x = 5 TO 24
        z = z + 1
        name1$ = SPACE$(20)
        name2$ = SPACE$(20)
        number1$ = SPACE$(15)
        number2$ = SPACE$(15)
        LSET name1$ = name$(z + dirpage)
        LSET name2$ = name$(z + 20 + dirpage)
        LSET number1$ = number$(z + dirpage)
        LSET number2$ = number$(z + 20 + dirpage)
        LOCATE x, 1: PRINT name1$; TAB(23); number1$; TAB(41); name2$; TAB(63); number2$;
      NEXT x
      prompt "[H] HELP             [Home]  [End]  [PgUp]  [PgDn]              [Esc] EXIT"
END SUB

SUB writedatafile
    prompt "Directory " + datafile$ + " modified."
    datafile = FREEFILE
    OPEN datafile$ FOR OUTPUT AS datafile
    WRITE #datafile, version, port$, tone$, initial$, prefix$, path$, fore, back, high, freq, mouseon
    FOR x = 1 TO numrecs
        WRITE #datafile, name$(x), number$(x)
    NEXT x
    CLOSE datafile
END SUB

SUB writescreen (indent)
    FOR x = 5 TO 24
        IF NOT l$(x) = "" THEN
        LOCATE x, indent: PRINT l$(x)
        l$(x) = ""
        END IF
    NEXT x
END SUB